home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
ELECTRIC
/
DSPICE0S.ZIP
/
comprs.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-22
|
6KB
|
181 lines
/* comprs.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
doublereal cpyknt;
integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk,
loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8,
nwd16;
} memmgr_;
#define memmgr_1 memmgr_
/*< subroutine comprs(icode,limit) >*/
/* Subroutine */ int comprs_(icode, limit)
integer *icode, *limit;
{
static integer madr, nblk, mspc, morg, muse, mslp, msiz, ltab1, ltab2,
madr2, morg2, muse2;
extern /* Subroutine */ int copy4_();
static integer muser, iwsize;
extern integer nxtevn_();
/*< implicit double precision (a-h,o-z) >*/
/* this routine compresses all available memory into a single block.
*/
/* if *icode* is zero, compression of memory from word 1 to *limit* is */
/* done; otherwise, compression from *ldval* down to *limit* is done. */
/* spice version 2g.6 sccsid=memmgr 3/15/83 */
/*< common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
/*< 1 ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
/*< 2 nwd8,nwd16 >*/
/*< if (icode.ne.0) go to 100 >*/
if (*icode != 0) {
goto L100;
}
/*< nblk=numblk >*/
nblk = memmgr_1.numblk;
/*< ltab2=loctab >*/
ltab2 = memmgr_1.loctab;
/*< 10 ltab1=ltab2 >*/
L10:
ltab1 = ltab2;
/*< if (ltab1.ge.limit) go to 200 >*/
if (ltab1 >= *limit) {
goto L200;
}
/*< if (nblk.eq.1) go to 200 >*/
if (nblk == 1) {
goto L200;
}
/*< nblk=nblk-1 >*/
--nblk;
/*< ltab2=ltab1+ntab >*/
ltab2 = ltab1 + memmgr_1.ntab;
/*< morg=istack(ltab1+1) >*/
morg = memmgr_1.istack[ltab1];
/*< msiz=istack(ltab1+2) >*/
msiz = memmgr_1.istack[ltab1 + 1];
/*< muse=nxtevn(istack(ltab1+3)) >*/
muse = nxtevn_(&memmgr_1.istack[ltab1 + 2]);
/*< mslp=istack(ltab1+6) >*/
mslp = memmgr_1.istack[ltab1 + 5];
/*< if ((msiz-muse).le.mslp) go to 10 >*/
if (msiz - muse <= mslp) {
goto L10;
}
/*< muse=muse+mslp >*/
muse += mslp;
/* ... move succeeding block down */
/*< morg2=istack(ltab2+1) >*/
morg2 = memmgr_1.istack[ltab2];
/*< muse2=istack(ltab2+3) >*/
muse2 = memmgr_1.istack[ltab2 + 2];
/*< madr2=istack(ltab2+4) >*/
madr2 = memmgr_1.istack[ltab2 + 3];
/*< iwsize=istack(ltab2+5) >*/
iwsize = memmgr_1.istack[ltab2 + 4];
/*< if (madr2.ne.0) go to 15 >*/
if (madr2 != 0) {
goto L15;
}
/*< if (muse2.eq.0) go to 20 >*/
if (muse2 == 0) {
goto L20;
}
/*< 15 cpyknt=cpyknt+dble(muse2) >*/
L15:
memmgr_1.cpyknt += (doublereal) muse2;
/*< call copy4(istack(nwoff+morg2+1),istack(nwoff+morg+muse+1),muse2) >*/
copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg2], &memmgr_1.istack[
memmgr_1.nwoff + morg + muse], &muse2);
/*< istack(lorg+madr2)=(morg+muse)/iwsize >*/
memmgr_1.istack[memmgr_1.lorg + madr2 - 1] = (morg + muse) / iwsize;
/*< 20 istack(ltab1+2)=muse >*/
L20:
memmgr_1.istack[ltab1 + 1] = muse;
/*< istack(ltab2+1)=morg+muse >*/
memmgr_1.istack[ltab2] = morg + muse;
/*< istack(ltab2+2)=istack(ltab2+2)+(msiz-muse) >*/
memmgr_1.istack[ltab2 + 1] += msiz - muse;
/*< go to 10 >*/
goto L10;
/*< 100 nblk=numblk >*/
L100:
nblk = memmgr_1.numblk;
/*< ltab2=ldval-ntab >*/
ltab2 = memmgr_1.ldval - memmgr_1.ntab;
/*< 110 ltab1=ltab2 >*/
L110:
ltab1 = ltab2;
/*< if (ltab1.le.limit) go to 200 >*/
if (ltab1 <= *limit) {
goto L200;
}
/*< if (nblk.eq.1) go to 200 >*/
if (nblk == 1) {
goto L200;
}
/*< nblk=nblk-1 >*/
--nblk;
/*< ltab2=ltab1-ntab >*/
ltab2 = ltab1 - memmgr_1.ntab;
/*< morg=istack(ltab1+1) >*/
morg = memmgr_1.istack[ltab1];
/*< msiz=istack(ltab1+2) >*/
msiz = memmgr_1.istack[ltab1 + 1];
/*< muser=istack(ltab1+3) >*/
muser = memmgr_1.istack[ltab1 + 2];
/*< muse=nxtevn(muser) >*/
muse = nxtevn_(&muser);
/*< madr=istack(ltab1+4) >*/
madr = memmgr_1.istack[ltab1 + 3];
/*< iwsize=istack(ltab1+5) >*/
iwsize = memmgr_1.istack[ltab1 + 4];
/*< mslp=istack(ltab1+6) >*/
mslp = memmgr_1.istack[ltab1 + 5];
/*< if ((msiz-muse).le.mslp) go to 110 >*/
if (msiz - muse <= mslp) {
goto L110;
}
/*< muse=muse+mslp >*/
muse += mslp;
/*< mspc=msiz-muse >*/
mspc = msiz - muse;
/*< cpyknt=cpyknt+dble(muser) >*/
memmgr_1.cpyknt += (doublereal) muser;
/*< call copy4(istack(nwoff+morg+1),istack(nwoff+morg+mspc+1),muser) >*/
copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg], &memmgr_1.istack[
memmgr_1.nwoff + morg + mspc], &muser);
/*< istack(ltab1+1)=morg+mspc >*/
memmgr_1.istack[ltab1] = morg + mspc;
/*< istack(ltab1+2)=muse >*/
memmgr_1.istack[ltab1 + 1] = muse;
/*< istack(ltab2+2)=istack(ltab2+2)+mspc >*/
memmgr_1.istack[ltab2 + 1] += mspc;
/*< if (madr.eq.0) go to 110 >*/
if (madr == 0) {
goto L110;
}
/*< istack(lorg+madr)=(morg+mspc)/iwsize >*/
memmgr_1.istack[memmgr_1.lorg + madr - 1] = (morg + mspc) / iwsize;
/*< go to 110 >*/
goto L110;
/* ... all done */
/*< 200 return >*/
L200:
return 0;
/*< end >*/
} /* comprs_ */